TOP

Fuzzy Lookup لـ LibreOffice Cac

FUZZYLOOKUP() الوصف

نعلم جميعًا الدالة VLOOKUP() المعروفة التي تساعدنا على دمج البيانات من جداول مختلفة. ومع ذلك، فإن هذه الوظيفة لها عيب واحد مهم - لا يمكنها الجمع بين قيم متشابهة، أي إذا كان هناك خطأ في الكلمة، فلن يكون هناك تطابق.

لكي نتمكن من الجمع بين القيم التقريبية، يمكننا إنشاء دالتنا الخاصة. دعنا نسميها FuzzyLookup().

لنتخيل أن لدينا قائمتين. كلاهما يحتويان على نفس العناصر تقريبًا، لكن قد تتم كتابتهما بشكل مختلف قليلاً. وتتمثل المهمة في العثور على العنصر الأكثر تشابهاً من القائمة الثانية لكل عنصر في القائمة الأولى، أي. تنفيذ بحث عن أقرب نص مماثل إلى أقصى حد.

والسؤال الكبير في هذه الحالة هو ما الذي يجب أخذه بعين الاعتبار معيار "التشابه". فقط عدد الأحرف المطابقة؟ هل عدد المباريات المتتالية ؟ هل يجب مراعاة حالة الأحرف أو المسافات؟ ماذا تفعل مع ترتيب مختلف للكلمات في العبارة؟ هناك العديد من الخيارات ولا يوجد حل واحد - لكل موقف سيكون أحدهما أفضل من الآخر.

في حالتنا، نقوم بتنفيذ الخيار الأبسط - البحث حسب الحد الأقصى لعدد تطابقات الأحرف. إنها ليست مثالية، ولكنها تعمل بشكل جيد في معظم المواقف.

رمز StarBASIC للوظيفة FuzzyLookup

لإضافة الدالة FuzzyLookup ، افتح القائمة Tools - Macros - Edit Macros... ، يختار Module1 وانسخ النص التالي إلى الوحدة:


Function FuzzyLOOKUP(LookupValue As String, SrcTable As Variant, Optional SimThreshold As Single) As String 
  ' moonexcel.com.ua 
  Dim Str       As String  
  Dim CellArray As Variant
  Dim StrArray  As Variant
  
  If IsMissing(SimThreshold) Then SimThreshold  = 0
  
  Str      = LCase(LookupValue)
  StrArray = Split(Str)
  StrExt   = UBound(StrArray)  
            
  For Each Cell In SrcTable
                          
    CellArray = Split(LCase(Cell))
    CellExt   = UBound(CellArray)    	    
    CellRate  = 0
	
    ' نتحقق من كل كلمة في عبارة البحث 
    For x = 0 To StrExt 
    
      StrWord = StrArray(x)	  
      If Len(StrWord) = 0 Then GoTo continue_x
	  MaxStrWordRate = 0
	  
      ' نتحقق من كل كلمة في الخلية التالية من جدول القيم الأصلي 
      For i = 0 To CellExt
        
        CellWord = CellArray(i)
		If Len(CellWord) = 0 Then GoTo continue_i
   
        FindCharNum = OccurrenceNum(StrWord, CellWord)
        StrWordRate = FindCharNum / Max(Len(StrWord),Len(CellWord))
		
        If StrWordRate > MaxStrWordRate Then MaxStrWordRate = StrWordRate
		continue_i:
      Next i		    
		    		    
      CellRate = CellRate + MaxStrWordRate
	  continue_x:
    Next x               
        
    ' نحن نحافظ على أفضل مباراة 
    If CellRate > MaxCellRate Then    
      MaxCellRate = CellRate
      BestCell    = Cell          
       
      FindCharNum = OccurrenceNum(Str, Cell)
      SimRate     = FindCharNum / Max(Len(Str),Len(Cell))
    End If       
        
  Next Cell
    
  IF SimRate >= SimThreshold Then 
    IF SimThreshold = -1 Then
      ReturnValue = BestCell + " (" + Format(SimRate, "0.00") + ")"
    ElseIf SimThreshold = -2 Then
      ReturnValue = Format(SimRate, "0.00")
    Else
      ReturnValue = BestCell
    End If
  Else 
    ReturnValue = ""
  End If    
  
  FuzzyLOOKUP = ReturnValue
End Function


Function OccurrenceNum(ByVal SourceString As String, ByVal TargetString As String)
  For i = 1 To Len(SourceString)	         		        	        
    ' نحن نبحث عن حدوث كل رمز 
    Position = InStr(1, TargetString, Mid(SourceString, i, 1), 1)  
    ' نحن نزيد من عداد الصدف 
    If Position > 0 Then		  
      Count = Count + 1
      ' قم بإزالة الرمز الموجود 
      TargetString = Left(TargetString, Position - 1) + Right(TargetString, Len(TargetString) - Position)   
    End If
  Next i    
  OccurrenceNum = Count
End Function


Function Max(ByVal value1 As Variant, ByVal value2 As Variant)  
  If value1 > value2 Then
	Result = value1
  Else
	Result = value2
  End If
  Max = Result
End Function

التالي، إغلاق Macro Editor والعودة إلى ورقة العمل LibreOffice Cac - الآن يمكنك استخدام ميزتنا الجديدة FuzzyLookup() .